perm filename CYCDRA[1,LMM] blob sn#034834 filedate 1973-04-12 generic text, type T, neo UTF8
  (SPECIAL @(XBOT XSCL YBOT YSCL REALWIDTH REALHEIGHT CTAB PATS CURPAT 
                 PATSELECT TITLE LINE LABELL NLN NMX LLN FACE FACENUM 
                 REALBOTTOM REALEFT EPSILON)))))))
  (SETQ PATS @((TRAP ((1 4 3 2)(2 4 3 1)(3 4 2 1)(4 3 2 1))
               (5 (4 3 3 3 3)((1 4 (1 2 3 4))(2 3 (1 3 4))(3 3 (1 2 4))
                   (4 3 (1 2 3))(5 3 (2 3 4))))
               ((4 5 3 2 1)(3 5 4 2 1)(2 5 4 3 1)(1 4 3 2 1))
               (((3 . 4)1)((2 . 4)1) ((2 . 3) 1) ((1 . 4) 1) ((1 . 3) 1) ((1 . 2) 1))
               ((1 0 0) (2 1 2) (3 2 0) (4 1 1)))
         (HEX ((1 2 6) (2 3 1) (3 4 2) (4 5 3) (5 6 4) (6 5 1))
              (1 (6) ((1 6 (1 6 5 4 3 2))))
              ((6 1) (5 1)(4 1)(3 1)(2 1)(1 1))
              (((5 . 6)1)((4 . 5)1)((3 . 4)1)((2 . 3)1)((1 . 2)1)((1 . 6)1))
              ((1 1 3)(2 2 2)(3 2 1)(4 1 0)(5 0 1)(6 0 2)))
         (PENT ((1 5 2)(2 3 1)(3 4 2)(4 5 3)(5 1 4))
               (1 (5)((1 5 (1 2 3 4 5))))
               ((5 1)(4 1)(3 1)(2 1)(1 1))
               (((4 . 5)1)((3 . 4)1)((2 . 3)1)((1 . 5)1)((1 . 2)1))
               ((1 0 1)(2 1 2)(3 2 1)(4 2 0)(5 0 0)))
         (OCT ((1 2 8)(2 3 1)(3 4 2)(4 5 3)(5 6 4)(6 7 5)(7 8 6)(8 1 7))
              (1 (8)((1 8 (1 8 7 6 5 4 3 2))))
              ((8 1)(7 1)(6 1)(5 1)(4 1)(3 1)(2 1)(1 1))
              (((7 . 8)1)((6 . 7)1)((5 . 6)1)((4 . 5)1)((3 . 4)1)
               ((2 . 3)1)((1 . 2)1)((1 . 8)1))
              ((1 0 2)(2 1 3)(3 2 3)(4 3 2)(5 3 1)(6 2 0)(7 1 0)(8 0 1)))))

  (SETQ PATSELECT @ ((4 15 15)
         (3 16 17)
         (1 17 15)
         (2 16 16)))

  (ARRAY TMP T 20)

  (ARRAY CONN T 20)

  (ARRAY NODE T 41)

  (DM PUSH (X)
      (LIST (QUOTE SETQ)
            (QUOTE STACK)
            (APPEND (QUOTE (! CONS))
                    (CDR X)
                    (QUOTE (STACK)))))

  (DM ! (L)
      ((LABEL FOO (LAMBDA (LL)
                           (COND
                             ((NULL (CDR LL))
                              NIL)
                             ((NULL (CDDR LL))
                              (CADR LL))
                             ((NULL (CDDDR LL))
                              LL)
                             (T (LIST (CAR LL)
                                      (CADR LL)
                                      (FOO (CONS (CAR LL)
                                                 (CDDR LL))))))))
       (CDR L)))

  (DM POP (X)
      (LIST (QUOTE PROG1)
            (LIST (QUOTE SETQ)
                  (CADR X)
                  (QUOTE (CAR STACK)))
            (QUOTE (SETQ STACK (CDR STACK)))))

  (DM STORENODEY (EXPR)
      (LIST (QUOTE STORE)
            (LIST (QUOTE NODE)
                  (LIST (QUOTE PLUS)
                        20
                        (CADR EXPR)))
            (CADDR EXPR)))

  (DM STORENODE (L)
      (LIST (QUOTE STORE)
            (LIST (QUOTE NODE)
                  (CADR L))
            (CADDR L)))

  (DM NODEY (L)
      (LIST (QUOTE NODE)
            (LIST (QUOTE PLUS)
                  20
                  (CADR L))))
  (DE DRAWS (STRUC ID)
    (PROG (CTAB)
      (SETQ CTAB (CTABLE STRUC))
      (LAYOUT
        (CONS (COND (ID ID) (T  (UGRAPH STRUC)))
              (FOR NEW CTE IN CTAB LIST
                   (CONS (NODENUM CTE)
                         (CONS (ATOMTYPE (MARKERS CTE))
                               (FOR NEW X IN (NBRS CTE)
                               WHEN (NUMBERP X)
                                    LIST X))))))))

  (DE PRINRAD (L)
      (PROG (CTAB)
            (PRINRAD1 NIL (FOR NEW I := ((NUMNODES L) 1 -1) XLIST I) L)
            (LAYOUT (CONS TITLE CTAB))))

  (DE PRINENTRY (N AT CON)
      (SETQ CTAB (CONS (CONS N (CONS AT CON)) CTAB)))

  (DE NUMNODES (RAD)
      (FOR NEW R IN (ATTACHEDRADS RAD)
           PLUS FIRST (IF (NULL (CENTER RAD))
                          THEN 0 ELSEIF (ATOM (CENTER RAD))
                          THEN 1 ELSEIF
                          (NOT (STRUCTURE? (RADSTRUC (CENTER RAD))))
                          THEN 1 ELSE
                          (LENGTH (NODES (RADSTRUC (CENTER RAD)))))
           (TIMES (CDR R)
                  (NUMNODES (CAR R)))))
  (DE LAYOUT (X)
  (PROG NIL (ANALIN X)
            (PATMATCH)
            (SORTLN)
            (FINDNDS 1 NIL)
            (RETURN (OUTNDS))))

  (DE ANALIN (X)
      (PROG (X1 X2 X3 X4)
	    (FOR NEW I :=(1 19) DO (STORE (CONN I) NIL))
            (SETQ TITLE (CAR X))
            (SETQ LINE NIL)
            (SETQ LABELL NIL)
            (SETQ NLN (LENGTH (CDR X)))
            (SETQ NMX 0)
            (FOR X1 IN (CDR X)
              AS NMX IS (MAX (CAR X1) NMX)
              AS X2 IS (CAR X1)
              AS LABELL IS (CONS (CONS X2 (CADR X1)) LABELL)
               FOR X3 IN (CDDR X1)
              DO (SETQ X4 (ASSOC2 (CONS X2 X3) LINE))
                 (COND ((NULL X4)
                        (COND ((ASSOC2 (CONS X3 X2) LINE) NIL)
                              (T (SETQ LINE (CONS (LIST (CONS X2 X3) 1) LINE)))))
                       (T (RPLACA (CDR X4) (ADD1 (CADR X4)))))
                 (COND ((MEMBER X3 (CONN X2)) NIL)
                       (T (STORE (CONN X2) (CONS X3 (CONN X2))))))
            (SETQ LLN (LENGTH LINE))
            (RETURN LINE)))